home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -seriously_amiga- / programming / other / scm / slib / mklibcat.scm < prev    next >
Text File  |  1999-04-19  |  6KB  |  186 lines
  1. ;"mklibcat.scm" Build catalog for SLIB
  2. ;Copyright (C) 1997 Aubrey Jaffer
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. (call-with-output-file (in-vicinity (implementation-vicinity) "slibcat")
  21.   (lambda (op)
  22.     (display ";\"slibcat\" SLIB catalog for " op)
  23.     (display (scheme-implementation-type) op)
  24.     (display (scheme-implementation-version) op)
  25.     (display ".        -*-scheme-*-" op) (newline op)
  26.     (display ";" op) (newline op)
  27.     (display "; DO NOT EDIT THIS FILE -- it is automagically generated" op)
  28.     (newline op) (newline op)
  29.  
  30.     (display "(" op) (newline op)
  31.     (for-each
  32.      (lambda (asp) (display " " op) (write asp op) (newline op))
  33.      (append
  34.       (list (cons 'schelog
  35.           (in-vicinity (sub-vicinity (library-vicinity) "schelog")
  36.                    "schelog"))
  37.         (cons 'portable-scheme-debugger
  38.           (in-vicinity (sub-vicinity (library-vicinity) "psd")
  39.                    "psd-slib")))
  40.       (map (lambda (p)
  41.          (if (symbol? (cdr p)) p
  42.          (cons
  43.           (car p)
  44.           (if (pair? (cdr p))
  45.               (cons 
  46.                (cadr p)
  47.                (in-vicinity (library-vicinity) (cddr p)))
  48.               (in-vicinity (library-vicinity) (cdr p))))))
  49.        '(
  50.          (rev4-optional-procedures    .    "sc4opt")
  51.          (rev2-procedures        .    "sc2")
  52.          (multiarg/and-        .    "mularg")
  53.          (multiarg-apply        .    "mulapply")
  54.          (rationalize        .    "ratize")
  55.          (transcript        .    "trnscrpt")
  56.          (with-file            .    "withfile")
  57.          (dynamic-wind        .    "dynwind")
  58.          (dynamic            .    "dynamic")
  59.          (fluid-let        defmacro    .    "fluidlet")
  60.          (alist            .    "alist")
  61.          (hash            .    "hash")
  62.          (sierpinski        .    "sierpinski")
  63.          (soundex            .    "soundex")
  64.          (hash-table        .    "hashtab")
  65.          (logical            .    "logical")
  66.          (random            .    "random")
  67.          (random-inexact        .    "randinex")
  68.          (modular            .    "modular")
  69.          (factor            .    "factor")
  70.          (primes            .    factor)
  71.          (charplot            .    "charplot")
  72.          (sort            .    "sort")
  73.          (tsort            .    topological-sort)
  74.          (topological-sort        .    "tsort")
  75.          (common-list-functions    .    "comlist")
  76.          (tree            .    "tree")
  77.          (format            .    "format")
  78.          (generic-write        .    "genwrite")
  79.          (pretty-print        .    "pp")
  80.          (pprint-file        .    "ppfile")
  81.          (object->string        .    "obj2str")
  82.          (string-case        .    "strcase")
  83.          (stdio            .    "stdio")
  84.          (printf            .    "printf")
  85.          (scanf            .    "scanf")
  86.          (line-i/o            .    "lineio")
  87.          (string-port        .    "strport")
  88.          (getopt            .    "getopt")
  89.          (debug            .    "debug")
  90.          (qp            .    "qp")
  91.          (break    defmacro    .    "break")
  92.          (trace    defmacro    .    "trace")
  93.          (eval            .    "eval")
  94.          (record            .    "record")
  95.          (promise            .    "promise")
  96.          (synchk            .    "synchk")
  97.          (defmacroexpand        .    "defmacex")
  98.          (macro-by-example    defmacro    .    "mbe")
  99.          (syntax-case        .    "scainit")
  100.          (syntactic-closures    .    "scmacro")
  101.          (macros-that-work        .    "macwork")
  102.          (macro            .    macro-by-example)
  103.          (object            .    "object")
  104.          (yasos        macro    .    "yasyn")
  105.          (oop            .    yasos)
  106.          (collect        macro    .    "collect")
  107.          (struct    defmacro    .    "struct")
  108.          (structure    syntax-case    .    "structure")
  109.          (values            .    "values")
  110.          (queue            .    "queue")
  111.          (priority-queue        .    "priorque")
  112.          (array            .    "array")
  113.          (array-for-each        .    "arraymap")
  114.          (repl            .    "repl")
  115.          (process            .    "process")
  116.          (chapter-order        .    "chap")
  117.          (posix-time        .    "psxtime")
  118.          (common-lisp-time        .    "cltime")
  119.          (time-zone            .    "timezone")
  120.          (relational-database    .    "rdms")
  121.          (database-utilities    .    "dbutil")
  122.          (database-browse        .    "dbrowse")
  123.          (html-form            .    "htmlform")
  124.          (alist-table        .    "alistab")
  125.          (parameters        .    "paramlst")
  126.          (getopt-parameters        .    "getparam")
  127.          (read-command        .    "comparse")
  128.          (batch            .    "batch")
  129.          (glob            .    "glob")
  130.          (filename            .    glob)
  131.          (make-crc            .    "makcrc")
  132.          (wt-tree            .    "wttree")
  133.          (string-search        .    "strsrch")
  134.          (root            .    "root")
  135.          (precedence-parse        .    "prec")
  136.          (parse            .    precedence-parse)
  137.          (commutative-ring        .    "cring")
  138.          (self-set            .    "selfset")
  139.          (determinant        .    "determ")
  140.          (byte            .    "byte")
  141.          (tzfile            .    "tzfile")
  142.          (schmooz            .    "schmooz")
  143.          (net-clients        .    "nclients")
  144.          (new-catalog        .    "mklibcat")
  145.          ))))
  146.     (display " " op)
  147.  
  148.     (let* ((req (in-vicinity (library-vicinity)
  149.                  (string-append "require" (scheme-file-suffix)))))
  150.       (write (cons '*SLIB-VERSION* (or (require:version req) *SLIB-VERSION*))
  151.          op))
  152.     (newline op)
  153.     (display ")" op) (newline op)
  154.  
  155.     (let ((load-if-exists
  156.        (lambda (path)
  157.          (cond ((not (file-exists? path))
  158.             (set! path (string-append path (scheme-file-suffix)))))
  159.          (cond ((file-exists? path)
  160.             (slib:load-source path))))))
  161.       ;;(load-if-exists (in-vicinity (implementation-vicinity) "mksitcat"))
  162.       (load-if-exists (in-vicinity (implementation-vicinity) "mkimpcat")))
  163.  
  164.     (let ((catcat
  165.        (lambda (vicinity name specificity)
  166.          (let ((path (in-vicinity vicinity name)))
  167.            (and (file-exists? path)
  168.             (call-with-input-file path
  169.               (lambda (ip)
  170.             (newline op)
  171.             (display "; " op)
  172.             (write path op)
  173.             (display " SLIB " op)
  174.             (display specificity op)
  175.             (display "-specific catalog additions" op)
  176.             (newline op) (newline op)
  177.             (do ((c (read-char ip) (read-char ip)))
  178.                 ((eof-object? c))
  179.               (write-char c op)))))))))
  180.       (catcat (library-vicinity) "sitecat" "site")
  181.       (catcat (implementation-vicinity) "implcat" "implementation")
  182.       (catcat (implementation-vicinity) "sitecat" "site"))
  183.     ))
  184.  
  185. (set! *catalog* #f)
  186.